#########################################################################################
# Package       Wx::Perl::SimpleThread::Thread::DoScript;
# Description:  Thread that runs script via 'do'
# Created       Tue Mar 30 05:50:47 2010
# SVN Id        $Id: DoScript.pm 5 2010-03-30 09:55:07Z mark.dootson $
# Copyright:    Copyright (c) 2010 Mark Dootson
# Licence:      This program is free software; you can redistribute it 
#               and/or modify it under the same terms as Perl itself
#########################################################################################

package Wx::Perl::SimpleThread::Thread::DoScript;;

#########################################################################################

use strict;
use warnings;
use Wx::Perl::SimpleThread::Thread;
use base qw( Wx::Perl::SimpleThread::Thread );

our $VERSION = '0.02';

#-----------------------------------------
# subs _standard_out and _standard_error
# exist so we can redirect output streams
# of the script we run to our event queues
#-----------------------------------------

sub _standard_out {
    my (@args) = @_;
    for(@args) {
        my $data = { stream => 'stdout', data => $_ };
        __PACKAGE__->queue_data( $data );
    }
}

sub _standard_error {
    my (@args) = @_;
    for(@args) {
        my $data = { stream => 'stderr', data => $_ };
        __PACKAGE__->queue_data( $data );
    }
}

#-----------------------------------------
# sub do_request is the only one that 
# we MUST override. The return value
# from this sub is sent back to
# 'on_thread_request_complete' in the
# handler instance that called us
#-----------------------------------------

sub do_request {
    my ($class, $params) = @_;
    #--------------------------------------------
    # We can do anything in do_request.
    # For this example we run an external
    # script via 'do' and collect the output but
    # we could just as easily put all the code
    # inline and set data back using
    # $class->queue_data( $data );
    # $data can be anything that can be sent
    # via Thread::Queue->enqueue
    #---------------------------------------------
    my $returnerror;
    {
        local @ARGV = @{ $params->{args} };
        local (*STDOUT, *STDERR);
        tie(*STDOUT => 'Wx::Perl::SimpleThread::Thread::StdOut', \&_standard_out ) ;
        tie(*STDERR => 'Wx::Perl::SimpleThread::Thread::StdErr', \&_standard_error ) ;
        do $params->{script};
        $returnerror = $@ if $@;
        untie(*STDOUT);
        untie(*STDERR);
    }
    if($returnerror) {
        return { errorflag => 1, errors =>  $returnerror };
    } else {
        return { errorflag => 0 };
    }
}

#---------------------------------------------------
# The two packages below exist in this example to
# allow us to redirect STDOUT and STDERR and
# therefore collect output of the script that
# we run in 'do_request'
#---------------------------------------------------

package Wx::Perl::SimpleThread::Thread::StdOut ;

our $VERSION = '0.02';

sub print_stdout {
    my $this = shift ;
    my $stdout = $this->{STDOUT} ;
    if ( ref($stdout) eq 'SCALAR' ) {
        $$stdout .= $_[0] ;
    } elsif ( ref($stdout) eq 'CODE' ) {
        &$stdout($_[0]) ;
    } else {
        print $stdout $_[0] ;
    }
    return 1 ;
}

sub TIEHANDLE {
  my $class = shift ;
  bless( { STDOUT => $_[0] }  , $class) ;
}

sub PRINT {
  my $this = shift ;
  $this->print_stdout( join("", (@_[0..$#_])) ) ;
  return 1 ;
}

sub PRINTF { &PRINT($_[0],sprintf($_[1],@_[2..$#_])) ;}

sub READ {}
sub READLINE {}
sub GETC {}
sub WRITE {}
sub FILENO {}
sub CLOSE {}
sub DESTROY {}

package Wx::Perl::SimpleThread::Thread::StdErr ;

our $VERSION = '0.02';

sub print_stderr {
    my $this = shift ;
    my $stderr = $this->{STDERR} ;
    if ( ref($stderr) eq 'SCALAR' ) {
        $$stderr .= $_[0] ;
    } elsif ( ref($stderr) eq 'CODE' ) {
        &$stderr($_[0]) ;
    } else {
        print $stderr $_[0] ;
    }
  return 1 ;
}

sub TIEHANDLE {
  my $class = shift ;
  bless( { STDERR => $_[0] }  , $class) ;
}

sub PRINT {
  my $this = shift ;
  $this->print_stderr( join("", (@_[0..$#_])) ) ;
  return 1 ;
}

sub PRINTF { &PRINT($_[0],sprintf($_[1],@_[2..$#_])) ;}

sub READ {}
sub READLINE {}
sub GETC {}
sub WRITE {}
sub FILENO {}
sub CLOSE {}
sub DESTROY {}

1;
